home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol047 / pccode1.bas < prev    next >
Encoding:
BASIC Source File  |  1987-01-11  |  12.0 KB  |  492 lines
  1. 1000 '
  2. 1010 '
  3. 1020 '         <<<<<  P C - C O D E 1  >>>>>
  4. 1030 '
  5. 1040 '
  6. 1050 '     * * * * * * * * * * * * * * * * * * * *
  7. 1060 '     *                                     *
  8. 1070 '     *  COPYRIGHT in Public Domain 1983    *
  9. 1080 '     *           by Richard N. Colvard     *
  10. 1090 '     *                                     *
  11. 1100 '     *  WARNING: This Program must be      *
  12. 1110 '     *           Compiled with IBM         *
  13. 1120 '     *           BASCOM/T/O                *
  14. 1130 '     *           Donot use BASICA          *
  15. 1140 '     *                                     *
  16. 1150 '     *  Highly recommend 8087 Link Libs    *
  17. 1160 '     *                                     *
  18. 1170 '     * * * * * * * * * * * * * * * * * * * *
  19. 1180 '
  20. 1190 '
  21. 1200 DIM B#(11), C#(47), CONS!(7), IX%(128)
  22. 1210 DIM ZI$(4), ZO$(4)   ' Dummy dimensions for field stmst ND error
  23. 1220 CONS!(1)=8: CONS!(2)=131072! : CONS!(3)=8192: CONS!(4)=128
  24. 1230 CONS!(5)=2: CONS!(6)=32 : CONS!(7)=2048
  25. 1240 M%=7: N%=13: YY! = 999991! : MU# = 16807 : MD# = 2147483647#
  26. 1250 W1$="12345678901234567890123456789012345678901234567890123456789012345678"
  27. 1260 W2$="         1         2         3         4         5         6"
  28. 1270 W3$=".........+.........+.........+.........+.........+.........+........"
  29. 1280 WZ$="P C   C o m p u t e r   S e c u r i t y    V1.33   PC-CODE1"
  30. 1290 SCREEN 0,1
  31. 1300 COLOR 15,9,1
  32. 1310 FOR J%=1 TO 128
  33. 1320 IX%(J%)=129 - J%
  34. 1330 NEXT J%
  35. 1340 CLS
  36. 1350 FOR J%=10 TO 15
  37. 1360 COLOR J%,9,1
  38. 1370 PRINT "P C - C O D E 1 ......Binary SuperEncipherment......"
  39. 1380 NEXT J%
  40. 1390 COLOR 15,9,1
  41. 1400 PRINT "  "
  42. 1410 PRINT "  "
  43. 1420 PRINT " ": PRINT " "
  44. 1430 PRINT " ": PRINT " "
  45. 1440 PRINT " Enter the type of KEY desired"
  46. 1450 PRINT "    Numeric; Number Only key ";
  47. 1460 COLOR 13,0,0: PRINT "N" : COLOR 15,9,1
  48. 1470 PRINT "    Alphabetic; alphanumeric ";
  49. 1480 COLOR 13,0,0: PRINT "A" : COLOR 15,9,1
  50. 1490 INPUT " Enter N or A ", T$
  51. 1500 T$=LEFT$(T$,1)
  52. 1510 IF T$="a" THEN T$="A"
  53. 1520 IF T$="n" THEN T$="N"
  54. 1530 IF T$ <> "A" AND T$ <> "N" THEN 1490
  55. 1540 IF T$="N" THEN 1590
  56. 1550 IF T$="A" THEN 3440
  57. 1560 '
  58. 1570 '
  59. 1580 '
  60. 1590 CLS
  61. 1600 PRINT WZ$
  62. 1610 PRINT " "
  63. 1620 PRINT " "
  64. 1630 PRINT " There are two(2) levels of Security HIGH and LOW"
  65. 1640 INPUT " Enter H for HIGH or L for LOW ", A$
  66. 1650 A$=LEFT$(A$,1)
  67. 1660 IF A$ <> "H" AND A$ <> "h" AND A$ <> "L" AND A$ <> "l" THEN 1620
  68. 1670 IF A$ = "H" OR A$ = "h" THEN 1800
  69. 1680 '
  70. 1690 '   ----------- LOW level of SECURITY -------------
  71. 1700 '
  72. 1710 PRINT " LOW Level of Security Selected"
  73. 1720 PRINT " "
  74. 1730 PRINT " You must now enter SEVEN (7) KEY numbers as indicated:"
  75. 1740 PRINT " "
  76. 1750 GOSUB 3650
  77. 1760 GOTO 2340
  78. 1770 '
  79. 1780 '
  80. 1790 '
  81. 1800 PRINT " "
  82. 1810 PRINT " You have Selected HIGH security"
  83. 1820 PRINT " "
  84. 1830 PRINT " You must enter ";1+N%+M%;" key numbers between 1 and 2,147,483,646"
  85. 1840 INPUT " A( 1 ) ? ", A#
  86. 1850 IF A# < 1 OR A# >= MD# THEN GOSUB 2190: GOTO 1840
  87. 1860 PRINT " "
  88. 1870 '
  89. 1880 '
  90. 1890 FOR J%=1 TO M%
  91. 1900 PRINT " B(";J%;") ";
  92. 1910 INPUT B#(J%)
  93. 1920 IF B#(J%) < 1 OR B#(J%) >= MD# THEN GOSUB 2190: GOTO 1900
  94. 1930 NEXT J%
  95. 1940 CLS
  96. 1950 '
  97. 1960 '
  98. 1970 FOR J%=1 TO N%
  99. 1980 PRINT " C(";J%;") ";
  100. 1990 INPUT C#(J%)
  101. 2000 IF C#(J%) < 1 OR C#(J%) >= MD# THEN GOSUB 2190: GOTO 1980
  102. 2010 IF J% = 18 THEN CLS
  103. 2020 IF J% = 36 THEN CLS
  104. 2030 NEXT J%
  105. 2040 '
  106. 2050 GOTO 2340
  107. 2060 '
  108. 2070 '
  109. 2080 '
  110. 2090 PRINT "[";X%;"] ";
  111. 2100 INPUT "Enter a NUMBER between 1 and 9,999,999 ", K2!
  112. 2110 IF K2! < 1 OR K2! > 9999999! THEN GOSUB 2190: GOTO 2090
  113. 2120 Z!=K2!
  114. 2130 GOSUB 2280
  115. 2140 S!=Z!
  116. 2150 RETURN
  117. 2160 '
  118. 2170 '
  119. 2180 '   ---------- ERROR Messages ----------
  120. 2190 BEEP
  121. 2200 COLOR 4+16,0,0
  122. 2210 PRINT " ERROR: Number RANGE must be 1 to 9,999,999"
  123. 2220 COLOR 15,1,9
  124. 2230 BEEP
  125. 2240 RETURN
  126. 2250 '
  127. 2260 '
  128. 2270 '   ------ scaling ---------
  129. 2280 Z! = Z! / 100!
  130. 2290 IF Z! > 1! THEN 2280
  131. 2300 RETURN
  132. 2310 '
  133. 2320 '
  134. 2330 '
  135. 2340 CLS
  136. 2350 PRINT " "
  137. 2360 PRINT WZ$
  138. 2370 PRINT " "
  139. 2380 PRINT " ": PRINT " "
  140. 2390 PRINT " Input and Output File may be the same file"
  141. 2400 PRINT " Only Valid files; no use of 'CON:' or 'LPT1:'"
  142. 2410 PRINT " ":PRINT " "
  143. 2420 INPUT "Enter Output file name (Full name): ", U$
  144. 2430 OPEN "R",2,U$,512
  145. 2440 INPUT "Enter Input FILE (full name): ", F1$
  146. 2450 OPEN "R",1,F1$,512
  147. 2460 FIELD #1,128 AS ZI$(1),128 AS ZI$(2),128 AS ZI$(3),128 AS ZI$(4)
  148. 2470 FIELD #2,128 AS ZO$(1),128 AS ZO$(2),128 AS ZO$(3),128 AS ZO$(4)
  149. 2480 L!=LOF(1) : SIZE%=L!/128
  150. 2490 IF (SIZE% * 128!) <> L! THEN SIZE% = SIZE% + 1
  151. 2500 SIZ2% = L! / 512
  152. 2510 IF (SIZ2% * 512) <> L! THEN SIZ2% = SIZ2% + 1
  153. 2520 PRINT " "
  154. 2530 INPUT "Encode or Decode (E or D) ",EN$
  155. 2540 EN$=LEFT$(EN$,1)
  156. 2550 IF EN$ = "e" THEN EN$="E"
  157. 2560 IF EN$ = "d" THEN EN$="D"
  158. 2570 IF EN$ <> "D" AND EN$ <> "E" THEN 2530
  159. 2580 CLS: PRINT WZ$: PRINT " ": PRINT " "
  160. 2590 END$=STRING$(12,0)
  161. 2600 COLOR 4+16,0,0
  162. 2610 PRINT " * * * R U N N I N G * * *"
  163. 2620 COLOR 15,9,1
  164. 2630 PRINT " "
  165. 2640 LAST%=0
  166. 2650 FOR Z9% = 1 TO SIZ2%
  167. 2660 GET #1, Z9%
  168. 2670 GOSUB 5390
  169. 2680 FOR JK% = 1 TO 4
  170. 2690 M2$=STRING$(128,0)
  171. 2700 IF LIMIT% >= SIZE% THEN LSET ZO$(JK%)=M2$ : GOTO 2980
  172. 2710 M$=ZI$(JK%)
  173. 2720 IF EN$="D" AND LEFT$(M$,12)=END$ THEN 2980
  174. 2730 L%=LEN(M$)
  175. 2740 IF L% = 0 THEN 2960
  176. 2750 IF EN$="D" THEN GOSUB 5600
  177. 2760 FOR J%=1 TO L%
  178. 2770 H%=ASC( MID$(M$,J%,1))
  179. 2780 S#=A#
  180. 2790 L=M%
  181. 2800 GOSUB 3060
  182. 2810 A#=S#
  183. 2820 B%=O%
  184. 2830 L=N%
  185. 2840 S#=B#(B%)
  186. 2850 GOSUB 3060
  187. 2860 B#(B%)=S#
  188. 2870 B%=O%
  189. 2880 S#=C#(B%)
  190. 2890 L=256
  191. 2900 GOSUB 3060
  192. 2910 C#(B%)=S#
  193. 2920 H%=H% XOR O%
  194. 2930 MID$(M2$,J%,1)=CHR$(H% AND 255)
  195. 2940 NEXT J%
  196. 2950 IF EN$="E" THEN GOSUB 5730
  197. 2960 LSET ZO$(JK%) = M2$
  198. 2970 LAST% = LAST% + 1
  199. 2980 NEXT JK%
  200. 2990 PUT #2, Z9%
  201. 3000 NEXT Z9%
  202. 3010 '
  203. 3020 GOTO 3220
  204. 3030 '
  205. 3040 '
  206. 3050 '   -------- RANDOM NUMBER GENERATOR (1) ------
  207. 3060 S# = S# * MU#
  208. 3070 S# = S# - (MD# * INT( S# / MD# )  )
  209. 3080 O%=1 + INT(L * (S# / MD#) )
  210. 3090 IF LAST% >= SIZE% THEN 2990
  211. 3100 RETURN
  212. 3110 '
  213. 3120 '
  214. 3130 '   -------- RANDOM NUMBER GENERATOR (2) ------
  215. 3140 S!=(S! + 1.352968) ^ 1.256973
  216. 3150 S!=S! - FIX(S!)
  217. 3160 O%=1 + INT(L * S!)
  218. 3170 RETURN
  219. 3180 '
  220. 3190 '
  221. 3200 '
  222. 3210 ' ------- CLEAR STORAGE & PREPARE TO STOP ---------
  223. 3220 LSET ZO$(1)=SPACE$(128): LSET ZI$(1)=SPACE$(128)
  224. 3230 LSET ZO$(2)=SPACE$(128): LSET ZI$(2)=SPACE$(128)
  225. 3240 LSET ZO$(3)=SPACE$(128): LSET ZI$(3)=SPACE$(128)
  226. 3250 LSET ZO$(4)=SPACE$(128): LSET ZI$(4)=SPACE$(128)
  227. 3260 CLOSE 2
  228. 3270 CLOSE 1
  229. 3280 Z!=0: A#=0: M2$=SPACE$(128): M$=M2$ : S! = 0: S# = 0
  230. 3290 FOR J%=1 TO M%
  231. 3300 B#(J%)=0
  232. 3310 NEXT J%
  233. 3320 FOR J%=1 TO N%
  234. 3330 C#(J%)=0
  235. 3340 NEXT J%
  236. 3350 FOR J%=1 TO 128
  237. 3360 IX%(J%)=0
  238. 3370 NEXT J%
  239. 3380 COLOR 15,0,0
  240. 3390 CLS
  241. 3400 END              '   S T O P
  242. 3410 '
  243. 3420 '   ----------- ALPHANUMERIC KEYS -----------
  244. 3430 '
  245. 3440 CLS
  246. 3450 PRINT WZ$
  247. 3460 PRINT " "
  248. 3470 PRINT " "
  249. 3480 PRINT " There are two(2) levels of Security HIGH and LOW"
  250. 3490 INPUT " Enter H for HIGH or L for LOW ", A$
  251. 3500 A$=LEFT$(A$,1)
  252. 3510 IF A$ <> "H" AND A$ <> "h" AND A$ <> "L" AND A$ <> "l" THEN 3470
  253. 3520 IF A$ = "H" OR A$ = "h" THEN 4730
  254. 3530 '
  255. 3540 '   ----------- LOW level of SECURITY -------------
  256. 3550 '
  257. 3560 PRINT " LOW Level of Security Selected"
  258. 3570 PRINT " "
  259. 3580 PRINT " You must now enter SEVEN (7) key Alphanumerics as indicated:"
  260. 3590 PRINT " "
  261. 3600 GOSUB 3650
  262. 3610 GOTO 2340
  263. 3620 '
  264. 3630 '
  265. 3640 '   ---------- KEY 1 ---------
  266. 3650 X%=1 : M% = 11 : N% = 47
  267. 3660 IF T$ = "A" THEN GOSUB 4860
  268. 3670 IF T$ = "N" THEN GOSUB 2090
  269. 3680 GOSUB 3140
  270. 3690 GOSUB 3140
  271. 3700 A#=FIX((1# - S!) * MD#)
  272. 3710 '
  273. 3720 '
  274. 3730 '   ---------- KEY 2 ----------
  275. 3740 X%=2
  276. 3750 IF T$ = "A" THEN GOSUB 4860
  277. 3760 IF T$ = "N" THEN GOSUB 2090
  278. 3770 GOSUB 3140
  279. 3780 L=4
  280. 3790 FOR J%=1 TO M%
  281. 3800 GOSUB 3140
  282. 3810 O2% = O%
  283. 3820 FOR K%=1 TO O2%
  284. 3830 GOSUB 3140
  285. 3840 NEXT K%
  286. 3850 GOSUB 3140
  287. 3860 B#(J%)=FIX((1# - S!) * MD#)
  288. 3870 NEXT J%
  289. 3880 '
  290. 3890 '
  291. 3900 '   ---------- KEY 3 -----------
  292. 3910 X%=3
  293. 3920 IF T$ = "A" THEN GOSUB 4860
  294. 3930 IF T$ = "N" THEN GOSUB 2090
  295. 3940 GOSUB 3140
  296. 3950 L=3
  297. 3960 FOR J%=1 TO N%
  298. 3970 GOSUB 3140
  299. 3980 O2% = O%
  300. 3990 FOR K%=1 TO O2%
  301. 4000 GOSUB 3140
  302. 4010 NEXT K%
  303. 4020 GOSUB 3140
  304. 4030 C#(J%)=FIX((1# - S!) * MD#)
  305. 4040 NEXT J%
  306. 4050 '
  307. 4060 '
  308. 4070 '   ---------- KEY 4 -------------
  309. 4080 X%=4
  310. 4090 IF T$ = "A" THEN GOSUB 4860
  311. 4100 IF T$ = "N" THEN GOSUB 2090
  312. 4110 GOSUB 3140
  313. 4120 L=INT(N%/2)
  314. 4130 GOSUB 3140
  315. 4140 K%=O% + 1
  316. 4150 L=N%
  317. 4160 FOR J%=1 TO K%
  318. 4170 GOSUB 3140
  319. 4180 L%=O%
  320. 4190 GOSUB 3140
  321. 4200 C#(L%)=FIX(S! * MD#)
  322. 4210 NEXT J%
  323. 4220 '
  324. 4230 '
  325. 4240 '   ----------- KEY 5 ---------------
  326. 4250 X%=5
  327. 4260 IF T$ = "A" THEN GOSUB 4860
  328. 4270 IF T$ = "N" THEN GOSUB 2090
  329. 4280 GOSUB 3140
  330. 4290 L=INT(M%/2)
  331. 4300 GOSUB 3140
  332. 4310 K%=O% + 1
  333. 4320 L=M%
  334. 4330 FOR J%=1 TO K%
  335. 4340 GOSUB 3140
  336. 4350 L%=O%
  337. 4360 GOSUB 3140
  338. 4370 B#(L%)=FIX(S! * MD#)
  339. 4380 NEXT J%
  340. 4390 '
  341. 4400 '
  342. 4410 '   ------------ KEY 6 ---------------
  343. 4420 X%=6
  344. 4430 IF T$ = "A" THEN GOSUB 4860
  345. 4440 IF T$ = "N" THEN GOSUB 2090
  346. 4450 GOSUB 3140
  347. 4460 L=M%
  348. 4470 FOR J%=1 TO M%
  349. 4480 GOSUB 3140
  350. 4490 D#=B#(O%)
  351. 4500 B#(O%)=B#(J%)
  352. 4510 B#(J%)=D#
  353. 4520 NEXT J%
  354. 4530 '
  355. 4540 '
  356. 4550 '   ------------- KEY 7 --------------
  357. 4560 X%=7
  358. 4570 IF T$ = "A" THEN GOSUB 4860
  359. 4580 IF T$ = "N" THEN GOSUB 2090
  360. 4590 GOSUB 3140
  361. 4600 L=N%
  362. 4610 FOR J%=1 TO N%
  363. 4620 GOSUB 3140
  364. 4630 D#=C#(O%)
  365. 4640 C#(O%)=C#(J%)
  366. 4650 C#(J%)=D#
  367. 4660 NEXT J%
  368. 4670 '
  369. 4680 RETURN
  370. 4690 '
  371. 4700 '   ---------- end of LOW security ------------
  372. 4710 '
  373. 4720 '
  374. 4730 CLS
  375. 4740 PRINT " You must enter 3 long PASSWORDS of alphanumeric data"
  376. 4750 X%=1
  377. 4760 GOSUB 5040
  378. 4770 X%=M%
  379. 4780 GOSUB 5040
  380. 4790 X%=N%
  381. 4800 GOSUB 5040
  382. 4810 '
  383. 4820 GOTO 2340
  384. 4830 '
  385. 4840 '
  386. 4850 '   --------- alphanumeric password to RND ------------
  387. 4860 PRINT "[";X%;"] Enter Password: ";
  388. 4870 LINE INPUT P$
  389. 4880 L%=LEN(P$)
  390. 4890 IF L% < 6 THEN PRINT "  *** password too short; not > 5": GOTO 4860
  391. 4900 IF X% = 1 THEN K! = 1
  392. 4910 FOR J%=1 TO L%
  393. 4920 C%=ASC( MID$(P$,J%,1) )
  394. 4930 LL%=L%
  395. 4940 IF LL% > 7 THEN LL%= LL% - (7 * INT(LL%/7)): LL%=LL%+1
  396. 4950 K! = ABS(K! + (CONS!(LL%) * C%) )
  397. 4960 NEXT J%
  398. 4970 Z! = K!
  399. 4980 GOSUB 2270
  400. 4990 S! = Z!
  401. 5000 RETURN
  402. 5010 '
  403. 5020 '
  404. 5030 '   ------- alphanumeric to DECIMAL --------
  405. 5040 X2%=X% * 5
  406. 5050 IF X%=1 THEN PRINT " (A) Enter Password of at least (MIN) ";X2%;" Chars"
  407. 5060 IF X%=M% THEN PRINT " (B) Enter Password of at least (MIN) ";X2%;" Chars"
  408. 5070 IF X%=N% THEN PRINT " (C) Enter Password of at least (MIN) ";X2%;" Chars"
  409. 5080 PRINT "  "
  410. 5090 PRINT "         "; LEFT$(W2$,X2%)
  411. 5100 PRINT "         "; LEFT$(W1$,X2%)
  412. 5110 PRINT "         "; LEFT$(W3$,X2%)
  413. 5120 PRINT "Password:";
  414. 5130 LINE INPUT P$
  415. 5140 PRINT "  "
  416. 5150 L%=LEN(P$)
  417. 5160 IF L% < X2% THEN PRINT "   *** Password TOO SHORT reenter ": GOTO 5040
  418. 5170 T%=INT(L%/X%)
  419. 5180 IF X%=1 THEN K#=1
  420. 5190 FOR K%=1 TO X%
  421. 5200 P2$=LEFT$(P$,T%)
  422. 5210 IF L% < 1 THEN 5330
  423. 5220 P$=MID$(P$,T%+1,L%)
  424. 5230 L%=L%-T%
  425. 5240 FOR J%=1 TO T%
  426. 5250 LL%=J%
  427. 5260 IF LL% > 7 THEN LL%= LL% - (7 * INT(LL%/7)): LL%=LL%+1
  428. 5270 K# = K# + (CONS!(LL%) * C%)
  429. 5280 NEXT J%
  430. 5290 IF X%=1 THEN A#=K#
  431. 5300 IF X%=M% THEN B#(K%) = K#
  432. 5310 IF X%=N% THEN C#(K%) = K#
  433. 5320 K# = K# - (MD# * INT( K# / MD# ))
  434. 5330 NEXT K%
  435. 5340 RETURN
  436. 5350 '
  437. 5360 '
  438. 5370 '   ------ TRANSPOSITION -------
  439. 5380 '
  440. 5390 FOR JJ%=1 TO 64
  441. 5400 L=M%
  442. 5410 S#=A#
  443. 5420 GOSUB 3060
  444. 5430 A#=S#
  445. 5440 B%=O%
  446. 5450 L=N%
  447. 5460 S#=B#(B%)
  448. 5470 GOSUB 3060
  449. 5480 B#(B%)=S#
  450. 5490 B%=O%
  451. 5500 S#=C#(B%)
  452. 5510 L=128
  453. 5520 GOSUB 3060
  454. 5530 C#(B%)=S#
  455. 5540 SWAP IX%(JJ%),IX%(O%)
  456. 5550 NEXT JJ%
  457. 5560 RETURN
  458. 5570 '
  459. 5580 '
  460. 5590 '
  461. 5600 FOR JJ%=1 TO 64
  462. 5610 G1%=IX%(JJ%)
  463. 5620 G2%=IX%(JJ%+64)
  464. 5630 G1$=MID$(M$,G1%,1)
  465. 5640 G2$=MID$(M$,G2%,1)
  466. 5650 SWAP G1$,G2$
  467. 5660 MID$(M$,G1%,1)=G1$
  468. 5670 MID$(M$,G2%,1)=G2$
  469. 5680 NEXT JJ%
  470. 5690 RETURN
  471. 5700 '
  472. 5710 '
  473. 5720 '
  474. 5730 FOR JJ%=1 TO 64
  475. 5740 G1%=IX%(JJ%)
  476. 5750 G2%=IX%(JJ%+64)
  477. 5760 G1$=MID$(M2$,G1%,1)
  478. 5770 G2$=MID$(M2$,G2%,1)
  479. 5780 SWAP G1$,G2$
  480. 5790 MID$(M2$,G1%,1)=G1$
  481. 5800 MID$(M2$,G2%,1)=G2$
  482. 5810 NEXT JJ%
  483. 5820 RETURN
  484. 5830 '
  485. 5840 '
  486. 5850 '
  487. 5860 END
  488. WAP G1$,G2$
  489. 5790 MID$(M2$,G1%,1)=G1$
  490. 5800 MID$(M2$,G2%,1)=G2$
  491. 5810 NEXT JJ%
  492. 5820 RETUR